home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1995 August: Tool Chest / Dev.CD Aug 95 TC / Dev.CD Aug 95 TC.toast / Tool Chest / Development Tools & Languages / Dylan Related / Dylan alpha demos / Online Insultant Pro src ƒ / Engine.dylan < prev    next >
Encoding:
Text File  |  1994-12-13  |  7.1 KB  |  217 lines  |  [TEXT/ttxt]
  1. language: infix-dylan
  2. module: Online-Insultant
  3.  
  4. /* Copyright (C) 1994, Apple Computer, Inc. All rights reserved. */
  5.  
  6. /* CREATE YOUR OWN SHAKESPEAREAN INSULTS by Jerry Maguire, who teaches
  7.  * English at Center Grove High School in Greenwood, Indiana. 
  8.  * 
  9.  * Combine one word from each of the three columns below, preface with "Thou"
  10.  * and thus shalt thou have the perfect insult.  Let thyself go--mix and
  11.  * match to find a barb worthy of the Bard! 
  12.  */
  13.  
  14. define constant column-A = #("artless",
  15.                     "bawdy",
  16.                     "beslubbering",
  17.                     "bootless",
  18.                     "churlish",
  19.                     "cockered",
  20.                     "clouted",
  21.                     "craven",
  22.                     "currish",
  23.                     "dankish",
  24.                     "dissembling",
  25.                     "droning",
  26.                     "errant",
  27.                     "fawning",
  28.                     "fobbing",
  29.                     "froward",
  30.                     "frothy",
  31.                     "gleeking",
  32.                     "goatish",
  33.                     "gorbellied",
  34.                     "impertinent",
  35.                     "infectious",
  36.                     "jarring",
  37.                     "loggerheaded",
  38.                     "lumpish",
  39.                     "mammering",
  40.                     "mangled",
  41.                     "mewling",
  42.                     "paunchy",
  43.                     "pribbling",
  44.                     "puking",
  45.                     "puny",
  46.                     "quailing",
  47.                     "rank",
  48.                     "reeky",
  49.                     "roguish",
  50.                     "ruttish",
  51.                     "saucy",
  52.                     "spleeny",
  53.                     "spongy",
  54.                     "surly",
  55.                     "tottering",
  56.                     "unmuzzled",
  57.                     "vain",
  58.                     "venomed",
  59.                     "villainous",
  60.                     "warped",
  61.                     "wayward",
  62.                     "weedy",
  63.                     "yeasty");
  64.  
  65. define constant column-B = #("base-court",
  66.                     "bat-fowling",
  67.                     "beef-witted",
  68.                     "beetle-headed",
  69.                     "boil-brained",
  70.                     "clapper-clawed",
  71.                     "clay-brained",
  72.                     "common-kissing",
  73.                     "crook-pated",
  74.                     "dismal-dreaming",
  75.                     "dizzy-eyed",
  76.                     "doghearted",
  77.                     "dread-bolted",
  78.                     "earth-vexing",
  79.                     "elf-skinned",
  80.                     "fat-kidneyed",
  81.                     "fen-sucked",
  82.                     "flap-mouthed",
  83.                     "fly-bitten",
  84.                     "folly-fallen",
  85.                     "fool-born",
  86.                     "full-gorged",
  87.                     "guts-griping",
  88.                     "half-faced",
  89.                     "hasty-witted",
  90.                     "hedge-born",
  91.                     "hell-hated",
  92.                     "idle-headed",
  93.                     "ill-breeding",
  94.                     "ill-nurtured",
  95.                     "knotty-pated",
  96.                     "milk-livered",
  97.                     "motley-minded",
  98.                     "onion-eyed",
  99.                     "plume-plucked",
  100.                     "pottle-deep",
  101.                     "pox-marked",
  102.                     "reeling-ripe",
  103.                     "rough-hewn",
  104.                     "rude-growing",
  105.                     "rump-fed",
  106.                     "shard-borne",
  107.                     "sheep-biting",
  108.                     "spur-galled",
  109.                     "swag-bellied",
  110.                     "tardy-gaited",
  111.                     "tickle-brained",
  112.                     "toad-spotted",
  113.                     "unchin-snouted",
  114.                     "weather-bitten");
  115.  
  116. define constant column-C = #("apple-john",
  117.                     "baggage",
  118.                     "barnacle",
  119.                     "bladder",
  120.                     "boar-pig",
  121.                     "bugbear",
  122.                     "bum-bailey",
  123.                     "canker-blossom",
  124.                     "clack-dish",
  125.                     "clotpole",
  126.                     "coxcomb",
  127.                     "codpiece",
  128.                     "death-token",
  129.                     "dewberry",
  130.                     "flap-dragon",
  131.                     "flax-wench",
  132.                     "flirt-gill",
  133.                     "foot-licker",
  134.                     "fustilarian",
  135.                     "giglet",
  136.                     "gudgeon",
  137.                     "haggard",
  138.                     "harpy",
  139.                     "hedge-pig",
  140.                     "horn-beast",
  141.                     "hugger-mugger",
  142.                     "jolthead",
  143.                     "lewdster",
  144.                     "lout",
  145.                     "maggot-pie",
  146.                     "malt-worm",
  147.                     "mammet",
  148.                     "measle",
  149.                     "minnow",
  150.                     "miscreant",
  151.                     "moldwarp",
  152.                     "mumble-news",
  153.                     "nut-hook",
  154.                     "pigeon-egg",
  155.                     "pignut",
  156.                     "puttock",
  157.                     "pumpion",
  158.                     "ratsbane",
  159.                     "scut",
  160.                     "skainsmate",
  161.                     "strumpet",
  162.                     "varlot",
  163.                     "vassal",
  164.                     "whey-face",
  165.                     "wagtail");
  166.  
  167. define constant random-element = method(sequence)
  168.   sequence[random-integer(size(sequence))];
  169.   end method;
  170.  
  171. // This is the entry point
  172. define constant random-insult = method()
  173.   concatenate("Thou ", random-element(column-A), " ",
  174.               random-element(column-B), " ",
  175.               random-element(column-C), "!");
  176.   end method;
  177.  
  178. // Import interfaces for random number generator
  179. define interface
  180.   #include "QuickDraw.h",
  181.      import: {"Random" => Random-16-bit};
  182.   struct "QDGlobals" => <QDGlobals>,
  183.      import: {"randSeed" => QDGlobals$randSeed};
  184.   #include "LowMem.h",
  185.      import: {"LMGetCurrentA5", "LMGetRndSeed"};
  186. end interface;
  187.  
  188. // Initialize the random number generator according to Inside Mac I-195
  189. define constant randomize = method()
  190.   let QDGlobals :: <QDGlobals> = as(<QDGlobals>, pointer-at(LMGetCurrentA5())
  191.                                                  - structure-size(<QDGlobals>) + 4);
  192.   QDGlobals$randSeed(QDGlobals) := LMGetRndSeed();
  193.   #t
  194. end method;
  195.  
  196. randomize();
  197.  
  198. // An integer >= 0 and < upper-bound
  199. // Apparently the framework exports a function to do this now
  200. // but I felt like keeping my own definition
  201. define constant random-integer = method(upper-bound :: <integer>)
  202.                                    => random-integer :: <integer>;
  203.   local method random-bits(accumulator, have, need)
  204.           if (have >= need) accumulator
  205.           else random-bits(ash(accumulator, 16) + Random-16-bit(),
  206.                            ash(have, 16),
  207.                            need);
  208.           end if;
  209.         end method;
  210.   let bits = case
  211.                upper-bound < 2 ^ 16 => Random-16-bit();
  212.                upper-bound < 2 ^ 32 => Random-16-bit() + ash(Random-16-bit(), 16);
  213.                otherwise            => random-bits(0, 1, upper-bound);
  214.              end case;
  215.   modulo(bits, upper-bound);         
  216. end method;
  217.